home *** CD-ROM | disk | FTP | other *** search
/ Aminet 24 / Aminet 24 (1998)(GTI - Schatztruhe)[!][Apr 1998].iso / Aminet / dev / c / AmiVoGL_MDEV.lha / examples / fcirctxt.for < prev    next >
Text File  |  1991-06-03  |  3KB  |  169 lines
  1. c
  2. c display all the hershey fonts and demonstrate textang
  3. c
  4.     program fcirctxt
  5.  
  6. $INCLUDE: 'fvogl.h'
  7. $INCLUDE: 'fvodevic.h'
  8.  
  9.     character*40 str1, str2, str3, str4, fonts(22)
  10.     character*100 buf
  11.     integer i
  12.     integer *2 val
  13.     data fonts/ 'astrology', 'cursive', 'futura.l',
  14.      +      'futura.m', 'gothic.eng', 'gothic.ger',
  15.      +      'gothic.ita', 'greek', 'japanese', 'markers',
  16.      +      'math.low', 'math.upp', 'meteorology', 'music',
  17.      +      'cyrillic', 'script', 'symbolic', 'times.g',
  18.      +      'times.ib', 'times.i', 'times.r', 'times.rb' /
  19.  
  20.     data str1/ 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' /
  21.     data str2/ 'abcdefghijklmnopqrstuvwxyz' /
  22.     data str3/ '1234567890+-=!@#$%^&*(){}[]' /
  23.     data str4/ '<>,./?~`\|_BONK,blark' /
  24.  
  25.     call winope('fcirctxt', 8)
  26.  
  27. c
  28. c we are interested in Keyboard events...
  29. c
  30.     call unqdev(INPUTC)
  31.     call qdevic(KEYBD)
  32.  
  33.     call color(BLACK)
  34.     call clear
  35.  
  36. c
  37. c define the world space
  38. c
  39.     call ortho2(-14.0, 14.0, -14.0, 14.0)
  40.  
  41.     do 10 i = 1, 22
  42.  
  43. c
  44. c textang is used to specify the orientation of text. As
  45. c we want the title to come out straight we make sure it is
  46. c zero each time we go through this loop.
  47. c
  48.         call htexta(0.0)
  49.  
  50. c
  51. c do the title
  52. c
  53.         call color(YELLOW)
  54.         call hfont('futura.m', 8)
  55.         buf = ' '
  56.         write(buf, '(''This is Hershey font '',a)') fonts(i)
  57.         call hboxte(-11.0, 12.0, 20.0, 1.0, buf, 32)
  58.  
  59. c
  60. c draw a box around the title
  61. c
  62.         call rect(-11.0, 12.0, 9.0, 13.0)
  63.  
  64.         call color(GREEN)
  65.  
  66. c
  67. c grab a font from the table
  68. c
  69.         call hfont(fonts(i), nchars(fonts(i)))
  70.  
  71. c
  72. c show the outer ring
  73. c
  74.         call htexts(1.5, 1.5)
  75.         call ShowCi(11.0, str1)
  76.  
  77. c
  78. c show the second ring
  79. c
  80.         call htexts(1.3, 1.3)
  81.         call ShowCi(8.5, str2)
  82.  
  83. c
  84. c show the third ring
  85. c
  86.         call htexts(1.1, 1.1)
  87.         call ShowCi(7.0, str3)
  88.  
  89. c
  90. c show the inside ring
  91. c
  92.         call htexts(0.9, 0.9)
  93.         call ShowCi(5.0, str4)
  94.  
  95.         idum = qread(val)
  96.         if (idum .eq. QKEY) then
  97.         call gexit
  98.         stop
  99.         end if
  100.  
  101.         call color(BLACK)
  102.         call clear
  103. 10    continue
  104.  
  105.     call gexit
  106.  
  107.     end
  108. c
  109. c nchars
  110. c
  111. c return the real length of a string padded with blanks
  112. c
  113.     integer function nchars(str)
  114.     character *(*) str
  115.  
  116.     do 10 i = len(str), 1, -1
  117.         if (str(i:i) .ne. ' ') then
  118.             nchars = i
  119.             return
  120.         end if
  121. 10      continue
  122.  
  123.     nchars = 0
  124.  
  125.     return
  126.  
  127.     end
  128. c
  129. c ShowCi
  130. c
  131. c    show a ring of text
  132. c
  133.     subroutine ShowCi(r, str)
  134.     real r
  135.     character*(*) str
  136.  
  137.     real i, inc, x, y, a, pi
  138.     integer j
  139.     character*1 c
  140.     parameter (pi = 3.1415926535)
  141.  
  142.     j = 1
  143.     inc = 360.0 / nchars(str)
  144.  
  145.     do 10 i = 0, 360.0, inc
  146. c
  147. c calculate the next drawing position
  148. c
  149.         c = str(j:j)
  150.         x = r * cos(i * pi / 180.0)
  151.         y = r * sin(i * pi / 180.0)
  152.         call move2(x, y)
  153. c
  154. c calculate angle for next character
  155. c
  156.         a = 90.0 + i
  157. c
  158. c set the orientation of the next character
  159. c
  160.         call htexta(a)
  161. c
  162. c draw the character
  163. c
  164.         call hdrawc(c)
  165.         j = j + 1
  166. 10    continue
  167.  
  168.     end
  169.